home *** CD-ROM | disk | FTP | other *** search
/ SGI Hot Mix 17 / Hot Mix 17.iso / HM17_SGI / research / lib / pdmenu_alloc.pro < prev    next >
Text File  |  1997-07-08  |  24KB  |  796 lines
  1. ;
  2. ; $Id: pdmenu_alloc.pro,v 1.11 1997/01/15 03:11:50 ali Exp $
  3. ;
  4. ;  WidPdmenu
  5. ;   Widget Pull Down Menu class library
  6. ;
  7. ; Copyright (c) 1993-1997, Research Systems, Inc.  All rights reserved.
  8. ;   Unauthorized reproduction prohibited.
  9. ;
  10. ; MODIFICATION HISTORY
  11. ;       Written by:     Joshua Goldstein,       12/93
  12. ;
  13. ;
  14.  
  15.  
  16. ;
  17. ;  PDMENU_Icon
  18. ;       Return the pulldown menu toolbar icon
  19. ;
  20. FUNCTION PDMENU_Icon
  21.   RETURN, [ $
  22.     [ 0b, 0b, 0b, 0b ], $
  23.     [ 0b, 0b, 0b, 0b ], $
  24.     [ 0b, 0b, 0b, 0b ], $
  25.     [ 255b, 247b, 223b, 255b ], $
  26.     [ 1b, 20b, 80b, 128b ], $
  27.     [ 1b, 20b, 80b, 128b ], $
  28.     [ 249b, 148b, 83b, 158b ], $
  29.     [ 249b, 148b, 83b, 158b ], $
  30.     [ 1b, 20b, 80b, 128b ], $
  31.     [ 1b, 20b, 80b, 128b ], $
  32.     [ 255b, 247b, 255b, 255b ], $
  33.     [ 0b, 16b, 0b, 16b ], $
  34.     [ 0b, 16b, 0b, 16b ], $
  35.     [ 0b, 144b, 127b, 16b ], $
  36.     [ 0b, 144b, 127b, 16b ], $
  37.     [ 0b, 16b, 0b, 16b ], $
  38.     [ 0b, 16b, 0b, 16b ], $
  39.     [ 0b, 144b, 255b, 19b ], $
  40.     [ 0b, 144b, 255b, 19b ], $
  41.     [ 0b, 16b, 0b, 16b ], $
  42.     [ 0b, 16b, 0b, 16b ], $
  43.     [ 0b, 144b, 231b, 19b ], $
  44.     [ 0b, 144b, 231b, 19b ], $
  45.     [ 0b, 16b, 0b, 16b ], $
  46.     [ 0b, 16b, 0b, 16b ], $
  47.     [ 0b, 144b, 255b, 17b ], $
  48.     [ 0b, 144b, 255b, 17b ], $
  49.     [ 0b, 16b, 0b, 16b ], $
  50.     [ 0b, 16b, 0b, 16b ], $
  51.     [ 0b, 240b, 255b, 31b ], $
  52.     [ 0b, 0b, 0b, 0b ], $
  53.     [ 0b, 0b, 0b, 0b ]  $
  54.   ]
  55. END
  56.  
  57.  
  58. ;
  59. ;  PDMENU_Copy
  60. ;   Copy a pdmenu.
  61. ;   Method 1: Copies contents out out ptr and into copy, destroying ptr.
  62. ;   Method 2: Duplicates ptr including submenus
  63. ;
  64. PRO PDMENU_Copy, Ptr, Copy
  65.  
  66.   COMMON WidEd_Comm
  67.  
  68.     IF KEYWORD_SET(Copy) THEN BEGIN     ; Copy is already allocated
  69.         Ptr2Obj, Copy, Contents
  70.         SubPtrs = Contents.Value.SubMenuPtr
  71.         FOR I=1,N_ELEMENTS(SubPtrs)-1 DO BEGIN
  72.             IF(SubPtrs[I] NE 0L) THEN PDMENU_Destroy, Copy, /LEAVE_DIALOGS
  73.         ENDFOR
  74.  
  75.         Ptr2Obj, Ptr, Obj               ; Remove object from original pointer
  76.         Obj2Ptr, Obj, Copy              ; Store in copy pointer
  77.         WIDGET_CONTROL, Ptr, /DESTROY
  78.  
  79.     ENDIF ELSE BEGIN
  80.  
  81.         Ptr2Obj, Ptr, Obj, /COPY                ; Copy original ptr contents
  82.         Copy    = WIDGET_BASE(GROUP=TopDlg)     ; Make a new pointer
  83.  
  84.         ;       Copy submenus
  85.  
  86.         SubPtrs = Obj.Value.SubMenuPtr
  87.         FOR I=1,N_ELEMENTS(SubPtrs)-1 DO BEGIN
  88.             IF SubPtrs[I] NE 0L THEN BEGIN
  89.                 ClearVar, NewChild
  90.                 PDMENU_Copy, SubPtrs[I], NewChild
  91.                 SubPtrs[I]      = NewChild
  92.             ENDIF
  93.         ENDFOR
  94.         Obj.Value.SubMenuPtr    = SubPtrs
  95.  
  96.         Obj2Ptr, Obj, Copy              ; Store copy into new pointer
  97.     ENDELSE
  98. END
  99.  
  100.  
  101. ;
  102. ;  PDMENU_Destroy
  103. ;   Release resources for the given pdmenu
  104. ;
  105. PRO PDMENU_Destroy, Ptr, LEAVE_DIALOGS=ClearDlg
  106.  
  107.     ClearDlg    = KEYWORD_SET(ClearDlg) ; Make keyword 0/1, never <UNDEFINED>
  108.     Ptr2Obj, Ptr, Obj                   ; Get object
  109.  
  110.     IF N_ELEMENTS(Obj) EQ 0 THEN RETURN
  111.  
  112.     ; Reset Dialog Pointer to prevent destruction?
  113.     IF ClearDlg THEN Obj.Dialog = 0L
  114.  
  115.     IF WIDGET_INFO(Obj.Dialog, /VALID) THEN $           ; Valid Dialog?
  116.         WIDGET_CONTROL, Obj.Dialog, /DESTROY            ; Destroy it
  117.  
  118.     SubPtrs     = Obj.Value.SubMenuPtr                  ; Destroy submenus
  119.     FOR I=1,N_ELEMENTS(SubPtrs)-1 DO BEGIN
  120.         IF(SubPtrs[I] NE 0L) THEN $
  121.             PDMENU_Destroy, SubPtrs[I], LEAVE_DIALOGS=ClearDlg
  122.     ENDFOR
  123.  
  124.     WIDGET_CONTROL, Ptr, /DESTROY                       ; Destroy pointer
  125.  
  126.     ; Obj is local variable and is freed on return
  127. END
  128.  
  129.  
  130. ;
  131. ;  PDMENU_MakeStrVal
  132. ;       Create a string array based on a menu's contents
  133. ;       appropriate for placement inside a menu list box.
  134. ;
  135. ;       Precede submenus with a '*' notation.
  136. ;
  137. PRO PDMENU_MakeStrVal, Obj, Val
  138.     Strs        = Obj.Value.Str
  139.     Ptrs        = Obj.Value.SubMenuPtr
  140.     Val         = STRARR(N_ELEMENTS(Strs))
  141.     Val[0]      = "<Top Of List>"
  142.     FOR I=1, N_ELEMENTS(Strs)-1 DO BEGIN
  143.         IF Ptrs[I] NE 0L THEN Prefix = "* " ELSE Prefix = "  "
  144.         Val[I]  = Prefix + Strs[I]
  145.     ENDFOR
  146. END
  147.  
  148.  
  149. ;
  150. ;  PDMENU_Event
  151. ;   Event handling routine for a pdmenu dialog.  Shares common code
  152. ;   (c.f. widbuild.pro)
  153. ;
  154. PRO PDMENU_Event, Event
  155.  
  156.   COMMON WidEd_Comm
  157.  
  158.     WIDGET_CONTROL, Event.Id, GET_UVALUE=Ev                 ; Get Event
  159.     WIDGET_CONTROL, Event.Top, GET_UVALUE=Binfo, /NO_COPY   ; Get Dialog info
  160.     Ptr2Obj, Binfo.ObjPtr, Obj                              ; Get Object
  161.  
  162.     CASE Ev OF
  163.  
  164.     'NAME':     Obj.Name        = Event.Value
  165.     'FONT':     Obj.Font        = Event.Value
  166.     'UVALUE':   Obj.UValue      = Event.Value
  167.  
  168.     ;   User has selected an item in list.  The first item cannot
  169.     ;   be deleted or used as a submenu (just a place holder so we
  170.     ;   can add after it)
  171.     'LIST':     BEGIN
  172.         Binfo.Current   = Event.Index
  173.         WIDGET_CONTROL, Binfo.Delete, SENSITIVE=(Event.Index NE 0)
  174.         WIDGET_CONTROL, Binfo.SubMenu, SENSITIVE=(Event.Index NE 0)
  175.         END
  176.  
  177.     'XFONT':    DoXFont, Obj, Binfo.Foci[1]
  178.  
  179.     'DELETE':   BEGIN
  180.  
  181.         ;       If the item being deleted is a submenu, there are
  182.         ;       resources associated with it and those must be released
  183.         DelItem = Obj.Value[Binfo.Current]
  184.         IF DelItem.SubMenuPtr NE 0 THEN PDMENU_Destroy, DelItem.SubMenuPtr
  185.  
  186.         ;       Create a new value array
  187.  
  188.         Last    = N_ELEMENTS(Obj.Value)-1
  189.         IF Binfo.Current EQ Last THEN BEGIN
  190.                 Vals    = Obj.Value[0:Last-1]
  191.         ENDIF ELSE BEGIN
  192.                 Vals    = [ Obj.Value[0:Binfo.Current-1], $
  193.                                 Obj.Value[Binfo.Current+1:Last] ]
  194.         ENDELSE
  195.  
  196.  
  197.         ;       Redefine object to reflect new value.
  198.         NewObj = {                      $
  199.             Type:       Obj.Type,       $
  200.             Parent:     Obj.Parent,     $
  201.             Id:         Obj.Id,         $
  202.             Dialog:     Obj.Dialog,     $
  203.             Next:       Obj.Next,       $
  204.             Name:       Obj.Name,       $
  205.             Font:       Obj.Font,       $
  206.             UValue:     Obj.UValue,     $
  207.             Value:      Vals            $
  208.         }
  209.  
  210.         ;       Update list box to reflect changes
  211.         ;       Set list box selection to <Top of List>
  212.         ;       Have to desensitize delete/Add as Submenu buttons
  213.  
  214.         PDMENU_MakeStrVal, NewObj, Strs
  215.         WIDGET_CONTROL, Binfo.ListId, SET_VALUE=Strs
  216.         WIDGET_CONTROL, Binfo.ListId, SET_LIST_SELECT=0
  217.         Binfo.Current   = 0
  218.         WIDGET_CONTROL, Binfo.Delete, SENSITIVE=0
  219.         WIDGET_CONTROL, Binfo.SubMenu, SENSITIVE=0
  220.         Obj     = NewObj
  221.         END
  222.  
  223.     'ADDID':    BEGIN
  224.         ;       User has typed in the 'Button value:' field
  225.         ;       Consider <CR> to be the same as the 'Add' button
  226.         ;       Of course, don't add nil buttons
  227.  
  228.         WIDGET_CONTROL, Binfo.AddId, GET_VALUE=Val
  229.         Sens    = (Val[0] NE '')
  230.         WIDGET_CONTROL, Binfo.Add, SENSITIVE=Sens
  231.         IF Sens AND Event.Update THEN GOTO, AddEquiv
  232.         END
  233.  
  234.     'ADD':      BEGIN
  235.         WIDGET_CONTROL, Binfo.AddId, GET_VALUE=Val
  236.     AddEquiv:
  237.  
  238.         ;       If the user hasn't chosen where they want to add
  239.         ;       the new value, add it to the end of the list
  240.  
  241.         IF Binfo.Current NE -1 THEN     N = Binfo.Current       $
  242.         ELSE                            N = N_ELEMENTS(Obj.Value)-1
  243.  
  244.         Last    = N_ELEMENTS(Obj.Value)-1
  245.         Vals    = Obj.Value
  246.         NewVal  = { WE_MENUITEM, Val[0], 0L }
  247.         IF N EQ Last THEN BEGIN
  248.              Vals       = [ Vals, NewVal ]
  249.         ENDIF ELSE BEGIN
  250.              Vals       = [ Vals[0:N], NewVal, Vals[N+1:*] ]
  251.         ENDELSE
  252.  
  253.         ;       Redefine object to reflect addition
  254.  
  255.         NewObj = {                      $
  256.             Type:       Obj.Type,       $
  257.             Parent:     Obj.Parent,     $
  258.             Id:         Obj.Id,         $
  259.             Dialog:     Obj.Dialog,     $
  260.             Next:       Obj.Next,       $
  261.             Name:       Obj.Name,       $
  262.             Font:       Obj.Font,       $
  263.             UValue:     Obj.UValue,     $
  264.             Value:      Vals            $
  265.         }
  266.  
  267.         ;       Update list box to reflect change as well
  268.         PDMENU_MakeStrVal, NewObj, Strs
  269.         WIDGET_CONTROL, Binfo.ListId, SET_VALUE=Strs
  270.         Obj             = NewObj
  271.         Binfo.Current   = N+1
  272.  
  273.         ;       Set it to be the current selection
  274.         WIDGET_CONTROL, Binfo.ListId, SET_LIST_SELECT=N+1
  275.         WIDGET_CONTROL, Binfo.Delete, SENSITIVE=1
  276.         WIDGET_CONTROL, Binfo.SubMenu, SENSITIVE=1
  277.  
  278.         ;       Clear the 'Button Value:' field after adding
  279.         ;       a value.  Its easier for the user
  280.  
  281.         WIDGET_CONTROL, Binfo.AddId, SET_VALUE=''
  282.         WIDGET_CONTROL, Binfo.Add, SENSITIVE=0
  283.         END
  284.  
  285.     'SUBMENU':  BEGIN
  286.         ;       Build a submenu dialog (and allocate submenu if
  287.         ;       necessary).
  288.         SUBMENU_Build, Binfo.ObjPtr, Obj, Binfo.Current
  289.  
  290.         ;       Update parent (us) list box to reflect possible change
  291.         ;       of state.
  292.         PDMENU_MakeStrVal, Obj, Strs
  293.         WIDGET_CONTROL, Binfo.ListId, SET_VALUE=Strs
  294.         WIDGET_CONTROL, Binfo.ListId, SET_LIST_SELECT=Binfo.Current
  295.         END
  296.  
  297.     'DONE':     BEGIN
  298.         Accept, Obj, Binfo.ObjPtr
  299.         WIDGET_CONTROL, Event.Top, SET_UVALUE=Binfo, /NO_COPY
  300.         WIDGET_CONTROL, Event.Top, /DESTROY
  301.         RETURN
  302.         END
  303.  
  304.     'CANCEL':   BEGIN
  305.         Cancel, Obj, Binfo.ObjPtr
  306.         RETURN
  307.         END
  308.     ELSE:           MESSAGE, 'Unprocessed event: ' + Ev
  309.     ENDCASE
  310.  
  311.     Dirty   = 1
  312.  
  313.     SetNextFocus, Binfo, Event      ; Set next keyboard focus as necessary
  314.     Obj2Ptr, Obj, Binfo.ObjPtr      ; Put object back into pointer
  315.     WIDGET_CONTROL, Event.Top, SET_UVALUE=Binfo, /NO_COPY
  316. END
  317.  
  318.  
  319. ;
  320. ;  SUBMENU_Build
  321. ;   Create a dialog box a pdmenu submenu object.  If ptr is nil then
  322. ;   create the object as well.
  323. ;
  324. ;   The dialog and the object description contain unused fields.  They
  325. ;   are there so that we can use the PDMENU_Event and PDMENU_Alloc
  326. ;   routines on both menus and submenus.  Theres not many fields to begin
  327. ;   with and I feel the memory expense is justifyable
  328. ;
  329. PRO SUBMENU_Build, ParPtr, ParObj, SubIdx
  330.  
  331.   COMMON WidEd_Comm
  332.  
  333.     ; Lookup pointer in parent menu item table.  We need to pull it
  334.     ; out into a named variable for the alloc routine.
  335.     ; If the pointer was nil, now we need to put it back into the list
  336.     ; Otherwise, we did a little extra work
  337.  
  338.     Ptr = ParObj.Value[SubIdx].SubMenuPtr
  339.     PDMENU_Alloc, ParPtr, Ptr
  340.     ParObj.Value[SubIdx].SubMenuPtr     = Ptr
  341.  
  342.     MgrName = 'WE_PDMENU' + STRTRIM(Ptr, 2) ; Create dialog box name
  343.     IF XRegistered(MgrName) THEN RETURN     ; See if it already exists
  344.  
  345.     ;  Use the name of the submenu for generating title
  346.  
  347.     Title   = 'SubMenu ' + ParObj.Value[SubIdx].Str
  348.  
  349.     Ptr2Obj, Ptr, Obj
  350.  
  351.     ;   Create dialog box
  352.  
  353.     Base    = WIDGET_BASE(/COLUMN, TITLE=Title, GROUP_LEADER=TopDlg)
  354.  
  355.     Foci    = 0L
  356.  
  357.     Base1   = WIDGET_BASE(Base, /ROW, /FRAME)
  358.  
  359.     PDMENU_MakeStrVal, Obj, Val
  360.     List    = WIDGET_LIST(Base1, /FRAME, YSIZE=8, VALUE=Val, UVALUE='LIST')
  361.     Base2   = WIDGET_BASE(Base1, /FRAME, /COLUMN)
  362.     SubMenu = WIDGET_BUTTON(Base2, VALUE='Edit as a SubMenu', UVALUE='SUBMENU')
  363.     Delete  = WIDGET_BUTTON(Base2, VALUE='Delete', UVALUE='DELETE')
  364.     Add     = WIDGET_BUTTON(Base2, VALUE='Add', UVALUE='ADD')
  365.     AddFld  = Field(Base2, "Button Value:", "", 'ADDID', SIZE=20, /STRING)
  366.  
  367.     Dummy   = WIDGET_LABEL(Base, VALUE=" ")
  368.     Done    = WIDGET_BUTTON(Base, VALUE='Done', UVALUE='DONE')
  369.  
  370.     DlgInfo     = {             $
  371.         ListId:         List,   $
  372.         SubMenu:        SubMenu,$
  373.         Delete:         Delete, $
  374.         Add:            Add,    $
  375.         AddId:          AddFld, $
  376.         Current:        -1,     $
  377.         Foci:           Foci,   $
  378.         ObjPtr:         Ptr     $
  379.     }
  380.     Obj.Dialog  = Base
  381.  
  382.     WIDGET_CONTROL, SubMenu, SENSITIVE=0
  383.     WIDGET_CONTROL, Delete, SENSITIVE=0
  384.     WIDGET_CONTROL, Add, SENSITIVE=0
  385.     WIDGET_CONTROL, List, SET_LIST_SELECT=0
  386.     WIDGET_CONTROL, Base, SET_UVALUE=DlgInfo, /NO_COPY
  387.     WIDGET_CONTROL, Base, /REALIZE
  388.     XMANAGER, MgrName, Base, EVENT_HANDLER='PDMENU_Event', CLEANUP='MISC_Kill'
  389.     Obj2Ptr, Obj, Ptr
  390. END
  391.  
  392.  
  393. ;
  394. ;  PDMENU_Build
  395. ;   Create a dialog box a pdmenu object.  If ptr is nil then
  396. ;   create the object as well.
  397. ;
  398. PRO PDMENU_Build, Ptr, ParPtr
  399.  
  400.   COMMON WidEd_Comm
  401.  
  402.     PDMENU_Alloc, ParPtr, Ptr               ; Allocate object if necessary
  403.     MgrName = 'WE_PDMENU' + STRTRIM(Ptr, 2) ; Create dialog box name
  404.     IF XRegistered(MgrName) THEN RETURN     ; See if it already exists
  405.  
  406.     Title   = GetId(Ptr) + '(Child of ' + GetId(ParPtr) + ')'
  407.     Ptr2Obj, Ptr, Obj
  408.  
  409.     ;   Create dialog box
  410.  
  411.     Base    = WIDGET_BASE(/COLUMN, TITLE=Title, GROUP_LEADER=TopDlg)
  412.     Foci    = LONARR(3)
  413.  
  414.     ;   Event Related Info
  415.  
  416.     Base1   = WIDGET_BASE(Base, /ROW, /FRAME)
  417.  
  418.     PDMENU_MakeStrVal, Obj, Val
  419.     List    = WIDGET_LIST(Base1, /FRAME, YSIZE=8, VALUE=Val, UVALUE='LIST')
  420.     Base2   = WIDGET_BASE(Base1, /FRAME, /COLUMN)
  421.     SubMenu = WIDGET_BUTTON(Base2, VALUE='Edit as a SubMenu', UVALUE='SUBMENU')
  422.     Delete  = WIDGET_BUTTON(Base2, VALUE='Delete', UVALUE='DELETE')
  423.     Add     = WIDGET_BUTTON(Base2, VALUE='Add', UVALUE='ADD')
  424.     AddFld  = Field(Base2, "Button Value:", "", 'ADDID', SIZE=20, /STRING)
  425.  
  426.  
  427.     Foci[0] = Field(Base, "Name:", Obj.Name, 'NAME', SIZE=50, /STRING)
  428.     Base1   = WIDGET_BASE(Base,/ROW)
  429.     Foci[1] = Field(Base1, "Font:", Obj.Font, 'FONT', SIZE=50, /STRING)
  430.     IF !Version.OS NE 'Win32' AND !Version.OS NE 'MacOS' THEN $
  431.         XFontBtn    = WIDGET_BUTTON(Base1, VALUE="XFont", UVALUE="XFONT")
  432.     Foci[2] = Field(Base, "User Value:", Obj.UValue, 'UVALUE', SIZE=30,/STRING)
  433.  
  434.     BuildOkCancel, Base, Obj
  435.  
  436.     DlgInfo     = {             $
  437.         ListId:         List,   $
  438.         SubMenu:        SubMenu,$
  439.         Delete:         Delete, $
  440.         Add:            Add,    $
  441.         AddId:          AddFld, $
  442.         Current:        -1,     $
  443.         Foci:           Foci,   $
  444.         ObjPtr:         Ptr     $
  445.     }
  446.     Obj.Dialog  = Base
  447.  
  448.     WIDGET_CONTROL, SubMenu, SENSITIVE=0
  449.     WIDGET_CONTROL, Delete, SENSITIVE=0
  450.     WIDGET_CONTROL, Add, SENSITIVE=0
  451.     WIDGET_CONTROL, List, SET_LIST_SELECT=0
  452.     WIDGET_CONTROL, Base, SET_UVALUE=DlgInfo, /NO_COPY
  453.     WIDGET_CONTROL, Base, /REALIZE
  454.     XMANAGER, MgrName, Base, EVENT_HANDLER='PDMENU_Event', CLEANUP='MISC_Kill'
  455.     Obj2Ptr, Obj, Ptr
  456. END
  457.  
  458.  
  459. PRO PDMENU_MakeDesc, Obj, MenuDesc, Idx
  460.  
  461.     IF N_ELEMENTS(MenuDesc) EQ 0 THEN BEGIN
  462.         MenuDesc        = REPLICATE( { CW_PDMENU_S, 0, '' }, 1000 )
  463.         Idx             = 0
  464.     ENDIF
  465.  
  466.     N   = N_ELEMENTS(Obj.Value)
  467.     IF N EQ 1 THEN BEGIN
  468.         MenuDesc[Idx].Name      = '<Empty Menu>'
  469.         MenuDesc[Idx].Flags     = 2
  470.         Idx                     = Idx + 1
  471.     ENDIF ELSE BEGIN
  472.         FOR I=1,N-1 DO BEGIN
  473.             MenuDesc[Idx].Name  = Obj.Value[I].Str
  474.             Last                = Idx
  475.             Idx                 = Idx + 1
  476.             SubPtr              = Obj.Value[I].SubMenuPtr
  477.             IF SubPtr NE 0L THEN BEGIN
  478.                 MenuDesc[Last].Flags    = 1
  479.                 Ptr2Obj, SubPtr, SubObj
  480.                 PDMENU_MakeDesc, SubObj, MenuDesc, Idx
  481.                 Obj2Ptr, SubObj, SubPtr
  482.             ENDIF
  483.         ENDFOR
  484.  
  485.         ; Set the 'final entry' bit in the last entry of each menu/submenu
  486.         MenuDesc[Last].Flags    = MenuDesc[Last].Flags OR 2
  487.     ENDELSE
  488. END
  489.  
  490.  
  491. ;
  492. ;  PDMENU_Save
  493. ;   Save pdmenu information to a file.
  494. ;   This is a simple object to save.
  495. ;
  496. PRO PDMENU_Save, Unit, Ptr
  497.  
  498.   COMMON WidEd_Comm
  499.  
  500.     ON_IOERROR, BadWrite
  501.     Ptr2Obj, Ptr, Obj
  502.     WRITEU, Unit, N_ELEMENTS(Obj.Value) ; Save sizeof(value)
  503.     WRITEU, Unit, Obj                   ; Save basic information
  504.  
  505.     ;   Save any submenus
  506.     SubPtrs     = Obj.Value.SubMenuPtr
  507.     FOR I=1,N_ELEMENTS(SubPtrs)-1 DO BEGIN
  508.         IF SubPtrs[I] NE 0L THEN BEGIN
  509.             PDMENU_Save, Unit, SubPtrs[I]
  510.         ENDIF
  511.     ENDFOR
  512.  
  513.     Obj2Ptr, Obj, Ptr
  514.     RETURN
  515.  
  516.   BadWrite:
  517.     Dirty   = 2
  518. END
  519.  
  520.  
  521. ;
  522. ;  PDMENU_Restore
  523. ;   Read in a pdmenu object from a file
  524. ;
  525. PRO PDMENU_Restore, Unit, Parent, Ptr
  526.  
  527.     NItem       = 0
  528.     READU, Unit, NItem
  529.     PDMENU_Alloc, Parent, Ptr, N_ITEMS=NItem
  530.     Ptr2Obj, Ptr, Obj
  531.     READU, Unit, Obj
  532.  
  533.     SubPtrs     = Obj.Value.SubMenuPtr
  534.     FOR I=1,N_ELEMENTS(SubPtrs)-1 DO BEGIN
  535.         IF SubPtrs[I] NE 0L THEN BEGIN
  536.             ClearVar, Child
  537.             PDMENU_Restore, Unit, Ptr, Child
  538.             SubPtrs[I]  = Child
  539.         ENDIF
  540.     ENDFOR
  541.     Obj.Value.SubMenuPtr        = SubPtrs
  542.  
  543.     Obj2Ptr, Obj, Ptr
  544. END
  545.  
  546.  
  547. ;
  548. ;  PDMENU_Generate
  549. ;   Create a pdmenu object for previewing
  550. ;
  551. PRO PDMENU_Generate, Base, Ptr
  552.  
  553.     Ptr2Obj, Ptr, Obj
  554.     Id  = 0L            ; Prevent EXECUTE from creating a new variable
  555.  
  556.     ;   Build a command string
  557.  
  558.     PDMENU_MakeDesc, Obj, MenuDesc
  559.  
  560.     Cmd = 'Id = CW_PDMENU(Base, MenuDesc'
  561.     SAddCmd, Cmd, Obj.Font, 'FONT'
  562.  
  563.     Obj2Ptr, Obj, Ptr
  564.  
  565.     ; Create pdmenu by executing the command string we just built
  566.  
  567.     IF EXECUTE(Cmd+')') NE 1 THEN BEGIN
  568.         MESSAGE,'Could not create Pdmenu ' + VarName(Ptr)
  569.     ENDIF
  570. END
  571.  
  572.  
  573. ;
  574. ;  PDMENU_GenWid
  575. ;   Create IDL code for creating a PDMENU
  576. ;
  577. PRO PDMENU_GenWid, Unit, Ptr, Parent
  578.  
  579.     Name    = VarId(Ptr)                ; Get variable name of object
  580.     Ptr2Obj, Ptr, Obj                   ; Get object info
  581.  
  582.     DescName    = 'MenuDesc' + STRTRIM(Ptr,2)   ; Create value name
  583.  
  584.     PDMENU_MakeDesc, Obj, MenuDesc
  585.  
  586.     XPRINTF, Unit, '  ' + DescName + ' = [ $'
  587.  
  588.     ;   Now print out the contents of the description,
  589.     ;   indenting to indicate what is a child of what
  590.     ;   Note that if the final object is also a submenu
  591.     ;   one need to keep track of that fact.
  592.  
  593.     ;   Its a little non-intuitive how the indentation stuff works
  594.     ;   But basically, we keep track of the current indent level
  595.     ;   and how it will effect things for the NEXT item
  596.  
  597.     MenuIdx     = 0     ; Current index in the Description array
  598.     Level       = 1     ; Current indent level
  599.     PreDec      = 0     ; Indent level(s) not yet acknowledged
  600.  
  601.     REPEAT BEGIN
  602.         ;       Every item but the first one needs a comma and
  603.         ;       a continuation character appended to the line above
  604.  
  605.         IF MenuIdx NE 0 THEN XPRINTF, Unit, ', $ ; ', MenuIdx-1
  606.  
  607.         ;       Indent 4 characters + 2 characters for every level
  608.         ;       of indentation after the first
  609.  
  610.         FOR I=-1,LEVEL DO XPRINTF, Unit, FORMAT='(A)', "  ", /NO_EOL
  611.         Flags = MenuDesc[MenuIdx].Flags
  612.         XPRINTF, Unit, Flags, Qstring(MenuDesc[MenuIdx].Name), /NO_EOL, $
  613.                 FORMAT='("{ CW_PDMENU_S, ", I, ", ''",A,"'' }")'
  614.  
  615.         ;       See how the current object affects the level
  616.  
  617.         CASE Flags OF
  618.         0:      ;
  619.         1:      Level   = Level + 1
  620.         2:      BEGIN
  621.                 Level   = Level - 1 - PreDec
  622.                 PreDec  = 0
  623.                 END
  624.         3:      BEGIN
  625.                 Level   = Level + 1
  626.                 PreDec  = PreDec + 1
  627.                 END
  628.         ENDCASE
  629.  
  630.         ;       Go on to the next object
  631.  
  632.         MenuIdx = MenuIdx + 1
  633.  
  634.         ;       We know we are done when the level goes to 0.
  635.         ;       This happens after the last object has been written
  636.  
  637.     ENDREP UNTIL LEVEL EQ 0
  638.  
  639.     XPRINTF, Unit, FORMAT='(" $  ;",I)', MenuIdx-1
  640.  
  641.     PRINTF, Unit, FORMAT='(/"  ]"//)'   ; XPRINTF does wierd stuff
  642.  
  643.         ;       Lastly, write the code which calls the
  644.         ;       pulldown menu creation function with the description
  645.         ;       we just wrote.
  646.  
  647.     XPRINTF, Unit, FORMAT='("  ", A," = CW_PDMENU( ", A, ", ", A)', $
  648.         Name, Parent, DescName, /NO_EOL
  649.     XPRINTF, Unit, FORMAT='(A)', ", /RETURN_FULL_NAME", /NO_EOL
  650.     SSaveCmd, Unit, Obj.Font, 'FONT'
  651.     SSaveCmd, Unit, UValue(Obj, Ptr), "UVALUE"
  652.     XPRINTF, Unit, ')'
  653.  
  654.     Obj2Ptr, Obj, Ptr
  655. END
  656.  
  657.  
  658. ;
  659. ;  SavePDCase
  660. ;       Generate a case statement for the given String.
  661. ;       If the Item is actually a submenu, then call
  662. ;       SavePDCase for each child.
  663. ;
  664. ;       Parent contains the concatenation of all of the previous
  665. ;       submenu names separated by periods. This is done to
  666. ;       match the event.value returned by the event procedure
  667. ;       when CW_PDMENU is called with the RETURN_FULL_NAME flag --
  668. ;       which we do.
  669. ;
  670. PRO SavePDCase, Unit, Item, Parent
  671.  
  672.  
  673.     IF Item.SubMenuPtr NE 0L THEN BEGIN
  674.         NewParent       = Parent + Item.Str + '.'
  675.         Ptr2Obj, Item.SubMenuPtr, Obj
  676.         FOR I=1,N_ELEMENTS(Obj.Value)-1 DO BEGIN
  677.             SavePDCase, Unit, Obj.Value[I], NewParent
  678.         ENDFOR
  679.         Obj2Ptr, Obj, Item.SubMenuPtr
  680.  
  681.     ENDIF ELSE BEGIN
  682.  
  683.         ;       Normal string. Build a statement of the form:
  684.         ;       "<full-name>": BEGIN
  685.         ;               PRINT, "Event for <full-name>"
  686.         ;               END
  687.  
  688.         Name = Qstring(Parent + Item.Str)
  689.         PRINTF, Unit, "  '" + Name + "': BEGIN"
  690.         PRINTF, Unit, "    PRINT, 'Event for ", Name, "'"
  691.         PRINTF, Unit, '    END'
  692.  
  693.     ENDELSE
  694. END
  695.  
  696. ;
  697. ;  PDMENU_MenuEv
  698. ;
  699. ;       Generate IDL code to handle a menu event
  700. ;
  701. PRO PDMENU_MenuEv, Unit, OldUnit, Ptr
  702.  
  703.     Ptr2Obj, Ptr, Obj
  704.  
  705.     CASE Obj.Type OF
  706.  
  707.     'MAIN':     Goto, BaseType
  708.     'DEP':      Goto, BaseType
  709.     'BASE':     BEGIN
  710.     BaseType:
  711.  
  712.         ;       If the user wants to provide an event handler, don't
  713.         ;       do anything
  714.         ;       Otherwise, look for pull down menus
  715.  
  716.         IF Obj.EventFunc EQ '' AND Obj.EventProc EQ '' THEN BEGIN
  717.             DoFList2, Obj.children, 'PDMENU_MenuEv', Unit, OldUnit
  718.         ENDIF
  719.  
  720.         END
  721.  
  722.     'PDMENU':   BEGIN
  723.  
  724.         ;       Found a pull down menu.  Create an event handler
  725.         ;       routine for this menu.
  726.  
  727.         Obj2Ptr, Obj, Ptr
  728.         Id      = VarId(Ptr)
  729.         Ptr2Obj, Ptr, Obj
  730.  
  731.         IF FindMagic(Id, Unit, OldUnit) EQ 0 THEN BEGIN
  732.  
  733.             ; Write the routine header
  734.  
  735.             BeginMagic, Unit, Id
  736.  
  737.             PRINTF, Unit, FORMAT='(//"PRO ",A,"_Event, Event")', Id
  738.             PRINTF, Unit, FORMAT='(//A//A/)',               $
  739.                 '  CASE Event.Value OF '
  740.  
  741.             FOR I=1,N_ELEMENTS(Obj.Value)-1 DO BEGIN
  742.                 SavePDCase, Unit, Obj.Value[I], ''
  743.             ENDFOR
  744.  
  745.             ;       Write routine footer
  746.  
  747.             PRINTF, Unit, '  ENDCASE'
  748.             PRINTF, Unit, 'END'
  749.  
  750.             EndMagic, Unit, Id
  751.  
  752.         ENDIF
  753.  
  754.         END
  755.     ELSE:       ; Do nothing
  756.     ENDCASE
  757.  
  758.     Obj2Ptr, Obj, Ptr
  759. END
  760.  
  761.  
  762. ;
  763. ;  PDMENU_Alloc
  764. ;       Allocate a menu object.  Don't allocate if ptr is non-nil
  765. ;
  766. ;       If we are restoring an menu object it may have several
  767. ;       menu items already.  Allocate appropriately (N_ITEMS flag)
  768. ;
  769. PRO PDMENU_Alloc, Parent, Ptr, N_ITEMS=NItem
  770.   COMMON WidEd_Comm
  771.  
  772.     IF KEYWORD_SET(NItem) EQ 0 THEN NItem=1     ; Allocate 1 Item by dflt
  773.  
  774.     IF KEYWORD_SET(Ptr) NE 0 THEN RETURN    ; if(ptr != NULL) return;
  775.  
  776.     Val = REPLICATE( { WE_MENUITEM, '', 0L }, NItem )
  777.  
  778.     ;   No WE_PDMENU structure type
  779.     ;   Menus must be typeless so they can have dynamically alterable
  780.     ;   definition (Value changes)
  781.  
  782.     Ptr = WIDGET_BASE(GROUP=TopDlg)                         ; Make a pointer
  783.     Obj = {                     $
  784.         Type:           'PDMENU', $
  785.         Parent:         Parent, $ ; Pointer to parent
  786.         Id:             NewId(),$ ; Permanent Id
  787.         Dialog:         0L,     $ ; Save Dialog ID (need for Cut consistency)
  788.         Next:           0L,     $ ; index of next child/free/top
  789.         Name:           '',     $ ; object name
  790.         Font:           '',     $
  791.         UValue:         '',     $
  792.         Value:          Val     $
  793.     }
  794.     Obj2Ptr, Obj, Ptr
  795. END
  796.